io Programmo 37/IOPROG_37.ISO/SOFT/Multilizer.exe/disk1/data1.cab/data1/[Group9]VCL Source Standard/ivdsmult.pas

Pascal/Delphi Source File | 1999-08-12 | 16.7 KB | 634 lines

unit IvDsMult;

{$I IVMULTI.INC}

interface

uses
  Windows, SysUtils, Classes, IvSocket, IvDictio, IvMLTP, IvParser;

type
  TIvServerDictionary = class(TIvDictionary)
  protected
    FTranslationMode: TIvTranslationMode;
    FCodePage: Integer;
    FRemoteDictionaryName: String;
    FUserName: String;
    FPassword: String;
    FTimeout: Integer;
    FSocket: TIvWinSocket;
    FStream: TIvWinSocketStream;
    FUserType: TIvUserType;

    function GetAddress: String;
    procedure SetAddress(const value: String);

    function GetPort: Integer;
    procedure SetPort( value: Integer);

    procedure SetRemoteDictionaryName(const value: String);

    function ReadMessage(stream: TIvWinSocketStream; timeout: Integer): String;
    function ReadReply(timeout: Integer; raiseException: Boolean; var reply: String): Integer;

    function Transaction(const msg: String): String;
    function TransactionEx(const msg: String; raiseException: Boolean; var reply: String): Integer;

    function GetTranslationCount: Integer; override;
    function GetLanguageCount: Integer; override;
    procedure GetLanguageData(index: Integer; language: TIvLanguage); override;
    function GetLocaleCount: Integer; override;
    procedure GetLocaleData(index: Integer; locale: TIvLocale); override;
    procedure LanguageChanged(languageChanged, localeChanged: Boolean); override;

  public
    constructor Create(owner: TComponent); override;
    destructor Destroy; override;

    procedure Open; override;
    procedure Close; override;

    function TranslateString(
      const str: String;
      var translation: String): Boolean; override;
    function TranslateContextString(
      const str, form, component: String;
      var translation: String): Boolean; override;

    function GetTranslationMode: TIvTranslationMode; override;
    procedure TranslateStrings(translations: TList); override;

    procedure Login;
    procedure Logout;

    function GetDictionaries(names, owners, descriptions: TStrings): Integer;

    class procedure StringToLanguage(const str: String; language: TIvLanguage);
    class procedure StringToLocale(const str: String; locale: TIvLocale);

    class function GetLoginMessage(
      const userName, password: String;
      clientType: TIvClientType;
      const clientVersion: String;
      application: TIvApplicationType;
      codePage: Integer): String;

    property UserType: TIvUserType read FUserType;

  published
    property CodePage: Integer read FCodePage write FCodePage default DEFAULT_CODE_PAGE_C;
    property UserName: String read FUserName write FUserName;
    property Password: String read FPassword write FPassword;
    property RemoteDictionaryName: String read FRemoteDictionaryName write SetRemoteDictionaryName;
    property Address: String read GetAddress write SetAddress;
    property Port: Integer read GetPort write SetPort default DEFAULT_PORT_C;
    property Timeout: Integer read FTimeout write FTimeout default DEFAULT_TIMEOUT_C;
    property TranslationMode: TIvTranslationMode read FTranslationMode write FTranslationMode default ivtmMultiple;
  end;

implementation

constructor TIvServerDictionary.Create(owner: TComponent);
begin
  inherited Create(owner);

  FTimeout := DEFAULT_TIMEOUT_C;
  FCodePage := DEFAULT_CODE_PAGE_C;
  FTranslationMode := ivtmMultiple;

  FSocket := TIvWinSocket.Create;
  FSocket.Port := DEFAULT_PORT_C;
  SetAddress('127.0.0.1');
end;

destructor TIvServerDictionary.Destroy;
begin
  Close;
  FSocket.Free;
  inherited Destroy;
end;

function TIvServerDictionary.GetAddress: String;
begin
  if FSocket.Host <> '' then
    Result := FSocket.Host
  else
    Result := FSocket.Address;
end;

procedure TIvServerDictionary.SetAddress(const value: String);
begin
  if value <> Address then
  begin
    if IvIsDNSAddress(value) then
    begin
      FSocket.Host := value;
      FSocket.Address := '';
    end
    else
    begin
      FSocket.Address := value;
      FSocket.Host := '';
    end;
  end;
end;

function TIvServerDictionary.GetPort: Integer;
begin
  Result := FSocket.Port;
end;

procedure TIvServerDictionary.SetPort( value: Integer);
begin
  if value <> Port then
  begin
    FSocket.Port := value;
  end;
end;

procedure TIvServerDictionary.SetRemoteDictionaryName(const value: String);
begin
  if value <> RemoteDictionaryName then
  begin
    FRemoteDictionaryName := value;
    if IsOpen then
      Open;
  end;
end;

function TIvServerDictionary.ReadMessage(
  stream: TIvWinSocketStream;
  timeout: Integer): String;
const
  SEGMENT_C = 256;
var
  str: String;
  len, bytesRead: Integer;
begin
  Result := '';
  bytesRead := 0;
  repeat
    if stream.WaitForData(500) then
    begin
      SetLength(str, SEGMENT_C);
      bytesRead := stream.Read(str[1], SEGMENT_C);
      if bytesRead > 0 then
      begin
        SetLength(str, bytesRead);
        Result := Result + str;
      end;
    end;
  until (bytesRead < SEGMENT_C) or (str[SEGMENT_C] = Chr(0));

  // All MLTP messages are ended by the Chr(0) character. Removes this.

  len := Length(Result);
  if (len > 0) and (Result[len] = Chr(0)) then
    SetLength(Result, len - 1);
end;

function TIvServerDictionary.ReadReply(
  timeout: Integer;
  raiseException: Boolean;
  var reply: String): Integer;
var
  index: Integer;
begin
  Result := MLTP_ERROR_C;
  if FStream.WaitForData(timeout) then
  begin
    reply := ReadMessage(FStream, timeout);
    index := Pos(SPACE_C, reply);
    if index > 0 then
    begin
      Result := StrToInt(Copy(reply, 1, index - 1));
      reply := Copy(reply, index + 1, Length(reply));
    end
    else
    begin
      Result := StrToInt(reply);
      reply := '';
    end;
  end
  else if raiseException then
    raise EIvMLTPError.CreateMsg(MLTP_TIMEOUT_C, '');
end;

function TIvServerDictionary.Transaction(const msg: String): String;
begin
  TransactionEx(msg, True, Result);
end;

function TIvServerDictionary.TransactionEx(
  const msg: String;
  raiseException: Boolean;
  var reply: String): Integer;
begin
  // Writes the message

  FStream.Write(msg[1], Length(msg) + 1);

  // Reads the reply

  Result := ReadReply(FTimeout, IsOpen, reply);
  if raiseException and (Result <> MLTP_OK_C) then
    raise EIvMLTPError.CreateMsg(Result, '');
end;

function TIvServerDictionary.GetTranslationCount: Integer;
begin
  Result := StrToInt(Transaction(MLTP_GET_C + SPACE_C + MLTP_TRANSLATIONCOUNT_C));
end;

function TIvServerDictionary.GetLanguageCount: Integer;
begin
  Result := StrToInt(Transaction(MLTP_GET_C + SPACE_C + MLTP_LANGUAGECOUNT_C));
end;

procedure TIvServerDictionary.GetLanguageData(index: Integer; language: TIvLanguage);
begin
  StringToLanguage(
    Transaction(MLTP_GET_C + SPACE_C + MLTP_LANGUAGEDATA_C + SPACE_C + IntToStr(index)),
    language);
end;

function TIvServerDictionary.GetLocaleCount: Integer;
begin
  Result := StrToInt(Transaction(MLTP_GET_C + SPACE_C + MLTP_LOCALECOUNT_C));
end;

procedure TIvServerDictionary.GetLocaleData(index: Integer; locale: TIvLocale);
begin
  StringToLocale(
    Transaction(MLTP_GET_C + SPACE_C + MLTP_LOCALEDATA_C + SPACE_C + IntToStr(index)),
    locale);
end;

function TIvServerDictionary.TranslateString(
  const str: String;
  var translation: String): Boolean;
var
  resultCode: Integer;
begin
  resultCode := TransactionEx(
    MLTP_TRANSLATE_C + SPACE_C + str,
    False,
    translation);

  if resultCode = MLTP_OK_C then
  begin
    Result := translation[1] = '1';
    Delete(translation, 1, 2);
  end
  else
    raise EIvMLTPError.CreateMsg(resultCode, 'Could not translate the string');
end;

function TIvServerDictionary.TranslateContextString(
  const str, form, component: String;
  var translation: String): Boolean;
var
  resultCode: Integer;
begin
  resultCode := TransactionEx(
    MLTP_CONTEXT_C + SPACE_C + str + SEPARATOR_C + form + SEPARATOR_C + component,
    False,
    translation);

  if resultCode = MLTP_OK_C then
  begin
    Result := translation[1] = '1';
    Delete(translation, 1, 2);
  end
  else
    raise EIvMLTPError.CreateMsg(resultCode, 'Could not translate the string');
end;

procedure TIvServerDictionary.TranslateStrings(translations: TList);
var
  i, resultCode: Integer;
  msg, reply: String;
  parser: TIvAnsiParser;
  translation: TIvTranslation;
begin
  // Formats the translation strings

  msg := '';
  for i := 0 to translations.Count - 1 do
  begin
    if i > 0 then
      msg := msg + SEPARATOR_C;
    with TIvTranslation(translations[i]) do
      if FContextType = [] then
        msg := msg + Str
      else
        msg := msg + Str + SEPARATOR_C + Form + SEPARATOR_C + Component;
  end;

  // Sends the message

  if FContextType = [] then
    resultCode := TransactionEx(
      MLTP_TRANSLATE_C + SPACE_C + msg,
      False,
      reply)
  else
    resultCode := TransactionEx(
      MLTP_CONTEXT_C + SPACE_C + msg,
      False,
      reply);

  if resultCode = MLTP_OK_C then
  begin
    // Gets translations

    parser := TIvAnsiParser.CreateValue(reply, SEPARATOR_C);
    try
      for i := 0 to translations.Count - 1 do
      begin
        translation := TIvTranslation(translations[i]);
        translation.Exists := parser.GetBoolean;
        if translation.Exists then
          translation.Current := parser.GetString;
      end;
    finally
      parser.Free;
    end;
  end
  else
    raise EIvMLTPError.CreateMsg(resultCode, 'Could not translate the strings');
end;

procedure TIvServerDictionary.LanguageChanged(languageChanged, localeChanged: Boolean);
begin
  Transaction(MLTP_SET_C + SPACE_C + MLTP_LANGUAGE_C + SPACE_C +
    IntToStr(FActiveLanguage) + SEPARATOR_C +
    IntToStr(FLanguageLocale) + SEPARATOR_C +
    '');

  inherited LanguageChanged(languageChanged, localeChanged);
end;

class procedure TIvServerDictionary.StringToLanguage(
  const str: String;
  language: TIvLanguage);
var
  parser: TIvAnsiParser;
begin
  parser := TIvAnsiParser.CreateValue(str, SEPARATOR_C);
  try
    language.Primary := parser.GetInteger;
    language.AllSubs := parser.GetString;
    language.DefaultSub := parser.GetInteger;

    language.ISOLanguage := parser.GetString;
    language.ISOAllCountries := parser.GetString;
    language.ISODefaultCountry := parser.GetString;

    language.CodePage := parser.GetInteger;
    language.EnglishName := parser.GetString;
    language.NativeName := parser.GetString;
    language.FontName := parser.GetString;
    language.FontSize := parser.GetInteger;
    language.OptionsAsInt := parser.GetInteger;
    language.Charset := parser.GetInteger;

    language.Init;
  finally
    parser.Free;
  end;
end;

class procedure TIvServerDictionary.StringToLocale(
  const str: String;
  locale: TIvLocale);
var
  i: Integer;
  parser: TIvAnsiParser;
begin
  parser := TIvAnsiParser.CreateValue(str, SEPARATOR_C);
  try
    locale.Primary := parser.GetInteger;
    locale.Sub := parser.GetInteger;
    locale.ISOLanguage := parser.GetString;
    locale.ISOCountry := parser.GetString;
    locale.CodePage := parser.GetInteger;
    locale.IsCustom := parser.GetBoolean;

    locale.EnglishLanguageName := parser.GetString;
    locale.EnglishCountryName := parser.GetString;
    locale.NativeLanguageName := parser.GetString;
    locale.NativeCountryName := parser.GetString;
    locale.Win16LanguageName := parser.GetString;
    locale.Win16CountryName := parser.GetString;

    locale.MeasurementSystem := TIvMeasurementSystem(parser.GetInteger);
    locale.CurrencyString := parser.GetString;
    locale.CurrencyFormat := TIvCurrencyFormat(parser.GetInteger);
    locale.NegCurrFormat := TIvNegativeCurrencyFormat(parser.GetInteger);
    locale.CurrencyDecimals := parser.GetInteger;
    locale.ThousandSeparator := parser.GetChar;
    locale.DecimalSeparator := parser.GetChar;

    locale.DateSeparator := parser.GetChar;
    locale.ShortDateFormat := parser.GetString;
    locale.LongDateFormat := parser.GetString;

    locale.TimeSeparator := parser.GetChar;
    locale.TimeAMString := parser.GetString;
    locale.TimePMString := parser.GetString;
    locale.TimeLeadingZeros := parser.GetBoolean;
    locale.TimeFormat := TIvTimeFormat(parser.GetInteger);
    locale.TimeMarkPosition := TIvTimeMarkPosition(parser.GetInteger);

    locale.CalendarType := TIvCalendarType(parser.GetInteger);
    locale.OptionalCalendarType := TIvCalendarType(parser.GetInteger);
    locale.FirstDayOfWeek := TIvDayOfWeek(parser.GetInteger);
    locale.FirstWeekOfYear := TIvFirstWeekOfYear(parser.GetInteger);

    for i := 1 to 12 do
      locale.ShortMonthNames[i] := parser.GetString;
    for i := 1 to 12 do
      locale.LongMonthNames[i] := parser.GetString;
    for i := 1 to 7 do
      locale.ShortDayNames[i] := parser.GetString;
    for i := 1 to 7 do
      locale.LongDayNames[i] := parser.GetString;

    // MLTP 1.0

    locale.Charset := parser.GetIntegerDef(0);

    locale.Init;
  finally
    parser.Free;
  end;
end;

class function TIvServerDictionary.GetLoginMessage(
  const userName, password: String;
  clientType: TIvClientType;
  const clientVersion: String;
  application: TIvApplicationType;
  codePage: Integer): String;
begin
  Result := MLTP_LOGIN_C + SPACE_C +
    IntToStr(CURRENT_MLTP_VERSION_C) + SEPARATOR_C +
    userName + SEPARATOR_C +
    password + SEPARATOR_C +
    IntToStr(Integer(clientType)) + SEPARATOR_C +
    clientVersion + SEPARATOR_C +
    IntToStr(Integer(application)) + SEPARATOR_C +
    IntToStr(codePage);
end;

procedure TIvServerDictionary.Login;
var
  clientType: TIvClientType;
  clientVersion: String;
begin
  // Opens the connection the dictionary server

  try
    FSocket.Open;
    FStream := TIvWinSocketStream.Create(FSocket, FTimeout);
  except
    raise EIvSocketError.Create('Could not make a connection to Dictionary Server at "' + Address + '"');
  end;

  clientVersion := '';
{$IFDEF IVVB}
  clientType := ivctVB;
{$ELSE}
  {$IFDEF VER90}
  clientType := ivctDelphi;
  clientVersion := '2';
  {$ELSE}
    {$IFDEF VER93}
  clientType := ivctCBuilder;
  clientVersion := '1';
    {$ELSE}
      {$IFDEF VER100}
  clientType := ivctDelphi;
  clientVersion := '3';
      {$ELSE}
        {$IFDEF VER110}
  clientType := ivctCBuilder;
  clientVersion := '3';
        {$ELSE}
          {$IFDEF VER120}
  clientType := ivctDelphi;
  clientVersion := '4';
          {$ELSE}
            {$IFDEF VER125}
  clientType := ivctCBuilder;
  clientVersion := '4';
            {$ELSE}
  clientType := ivctDelphi;
            {$ENDIF}
          {$ENDIF}
        {$ENDIF}
      {$ENDIF}
    {$ENDIF}
  {$ENDIF}
{$ENDIF}

  // version user password clientType clientVersion isApplet codePage

  FUserType := TIvUserType(StrToInt(Transaction(GetLoginMessage(
    FUserName,
    FPassword,
    clientType,
    clientVersion,
    ivatApplication,
    FCodePage))));
end;

procedure TIvServerDictionary.Logout;
begin
  if FSocket.Connected then
  begin
    try
      Transaction(MLTP_LOGOUT_C);
    except
    end;
    FSocket.Close;
    FStream.Free;
    FStream := nil;
  end;
end;

procedure TIvServerDictionary.Open;
var
  reply: String;
  parser: TIvAnsiParser;
begin
  if IsOpen then
    Exit;

  // Opens the dictionary

  Login;
  reply := Transaction(MLTP_OPEN_C + SPACE_C + FRemoteDictionaryName + SEPARATOR_C + '1');

  parser := TIvAnsiParser.CreateValue(reply, SEPARATOR_C);
  try
    parser.GetInteger;
    parser.GetInteger;
    FContextType := TIvContext.ContextCodeToType(TIvContextCode(parser.GetInteger));
  finally
    parser.Free;
  end;

  inherited Open;
end;

procedure TIvServerDictionary.Close;
begin
  if IsOpen then
  begin
    try
      Transaction(MLTP_CLOSE_C);
    except
    end;
    Logout;
  end;

  inherited Close;
end;

function TIvServerDictionary.GetDictionaries(names, owners, descriptions: TStrings): Integer;
var
  name, owner, description: String;
  parser: TIvAnsiParser;
begin
  Result := 0;
  parser := TIvAnsiParser.CreateValue(
    Transaction(MLTP_GET_C + SPACE_C + MLTP_DICTIONARIES_C),
    SEPARATOR_C);
  while not parser.Eol do
  begin
    name := parser.GetString;
    if names <> nil then
      names.Add(name);

    name := parser.GetString;
    if owners <> nil then
      owners.Add(owner);

    name := parser.GetString;
    if descriptions <> nil then
      descriptions.Add(description);

    Inc(Result);
  end;
  parser.Free;
end;

function TIvServerDictionary.GetTranslationMode: TIvTranslationMode;
begin
  Result := FTranslationMode;
end;

end.